home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0099_Console IO in BP7 ( Windows Bin ).pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  8.9 KB  |  307 lines
  1. (*
  2. >          Hi, I am trying to write a program the writes to Standard output,
  3. > and reads from Standard input from windows console (win95 dosprmpt, winnt
  4. >  dosprmpt)... so the io can be redirected.  The program must be a windows
  5. > program for the project to work:
  6. >                  Using the program as a script for Microsoft Internet
  7. > Information Server on Winnt 3.51, the web server will not execute dos based stdio
  8. > programs.  I have tried using program script(input,output) which reports file not
  9. > open  for write, I have added rewrite(output) which causes an error because output
  10. not assigned.  I have assigned output to '' which outputs nothing to the
  11. console or the redirected file.
  12. >
  13. >                  If anyone understands my problem, and has an idea or
  14. > solution,
  15. >  please help me.  Thank you.
  16. >
  17. >
  18. Ok, here is the solution to your prob : you need to write a text file device
  19. driver. I just happen to have code. You want the StdOut things, i can't
  20. remember how it works =(
  21. p.s. the file's attached.
  22. (*)
  23.  
  24. unit SimultIO;
  25. {$D-,F+,R-}
  26. (* Unit for simultaneous I/O.
  27.    This will be useful for redirection - when you write to a
  28.    file assigned to by AssignSimult, data written to it will write to
  29.    the file AND the screen. *)
  30. interface
  31. {$F+} procedure AssignSimult(var f : text;n : string); far; {$F-}
  32. implementation
  33. uses Dos,CRT;
  34. var  R : Registers;
  35.     OP : Text;
  36. {$F+} function WriteByteToFile(FileHandle : Word;var value) : integer;far; {$F-}
  37. var r : registers;
  38. begin
  39.  r.ah := $40;
  40.  r.bx := FileHandle;
  41.  r.cx := 1;
  42.  r.ds := seg(value);
  43.  r.dx := ofs(value);
  44.  MsDos(R);
  45.  if (r.flags and fcarry)<>0 then
  46.   begin
  47.    r.ah := $59; (* Get extended error info *)
  48.    msdos(R);
  49.    WriteByteToFile := r.ax; (* IOResult returns the value in InOutRes *)
  50.   end
  51.  else WriteByteToFile := 0;
  52. end;
  53. (*
  54.             INT 21,40 - Write To File or Device Using Handle
  55.         AH =  40h
  56.         BX =  file handle
  57.         CX =  number of bytes to write, a zero value truncates/extends
  58.              the file to the current file position
  59.         DS:DX =  pointer to write buffer
  60.  
  61.         on return:
  62.         AX =  number of bytes written if CF not set
  63.            =  error code if CF set  (see DOS ERROR CODES)
  64.  
  65.         - if AX is not equal to CX on return, a partial write occurred
  66.         - this function can be used to truncate a file to the current
  67.           file position by writing zero bytes                         *)
  68. {$F+} function StdOut(var f: textrec) : integer; far;  {$F-}
  69. var
  70.   p,err : integer;
  71.   r : registers;
  72. begin
  73.  if f.mode=fmclosed then
  74.   begin
  75.    StdOut := 103;
  76.    exit;
  77.   end;
  78.   with F do
  79.    begin
  80.     for P := 0 to bufpos-1 do
  81.      begin
  82.       r.ah := $02;
  83.       r.dl := ord(bufptr^[p]);
  84.       msdos(R);
  85.      end;
  86.    BufPos:=0;
  87.   end;
  88.   StdOut:=0;
  89. end;
  90. {$F+} function SimultWrite(var f: textrec): integer; far;  {$F-}
  91. var
  92.   p,err : integer;
  93. begin
  94.  if f.mode=fmclosed then
  95.   begin
  96.    SimultWrite := 103;
  97.    exit;
  98.   end;
  99.   with F do
  100.    begin
  101.     for P := 0 to bufpos-1 do
  102.      begin
  103.       err := WriteByteToFile(Handle,BufPtr^[p]);
  104.       if err<>0 then
  105.        begin
  106.         SimultWrite := Err;
  107.         BufPos := P+1;
  108.         exit;
  109.        end;
  110.       Write(OP,BufPtr^[p]);
  111.      end;
  112.    BufPos:=0;
  113.   end;
  114.   SimultWrite:=0;
  115. end;
  116. {$F+} function SimultOpen(var f: textrec): integer; far;  {$F-}
  117. var
  118.   P: integer;
  119. begin;
  120.   case F.Mode of
  121.    FMOutput : begin (* Rewrite *)
  122.                if f.name[0]= #0 then
  123.                 begin
  124.                 F.InOutFunc:= @StdOut;
  125.                 F.FlushFunc:= @StdOut;
  126.               end else begin
  127.                r.ah :=  $3C;
  128.                r.cx :=  $0000;
  129.                r.ds :=  Seg(F.Name);
  130.                r.dx :=  Ofs(F.Name);
  131.                MsDos(R);
  132.                if (R.flags and FCarry)<>0 then
  133.                 begin
  134.                  R.AH :=  $59;
  135.                  MsDos(R);
  136.                  SimultOpen :=  R.AX;
  137.                  exit;
  138.                 end;
  139.                F.Handle :=  r.ax;
  140.                (*
  141.                   INT 21,3C - Create File Using Handle
  142.  
  143.         AH =  3C
  144.         CX =  file attribute  (see FILE ATTRIBUTES)
  145.         DS:DX =  pointer to ASCIIZ path name
  146.  
  147.         on return:
  148.         CF =  0 if successful
  149.            =  1 if error
  150.         AX =  files handle if successful
  151.            =  error code if failure  (see DOS ERROR CODES)
  152.  
  153.         - if file already exists, it is truncated to zero bytes on opening
  154. *)
  155.                 F.InOutFunc:= @SimultWrite;
  156.                 F.FlushFunc:= @SimultWrite;
  157.                end;
  158.                F.BufPos:= 0;
  159.                SimultOpen:= 0;
  160.               end;
  161.    FMInOut  : begin (* Append *)
  162.                f.mode :=  fmOutput;
  163.                r.ah :=  $3d ;
  164.                r.al :=  $01;
  165.                r.cx :=  $0000;
  166.                r.ds :=  Seg(F.Name);
  167.                r.dx :=  Ofs(F.Name);
  168.                MsDos(R);
  169.                if (R.flags and FCarry)<>0 then
  170.                 begin
  171.                  R.AH :=  $59;
  172.                  MsDos(R);
  173.                  SimultOpen :=  R.ax;
  174.                  exit;
  175.                 end;
  176.                F.Handle :=  r.ax;
  177.                r.bx :=  r.ax;
  178.                r.al :=  $02;
  179.                R.ah :=  $42;
  180.                r.cx :=  $0000;
  181.                r.dx :=  $0001; (* Seek past EOF *)
  182.                MsDos(R);
  183.                if (r.flags and fcarry)<>0 then
  184.                 begin
  185.                  r.ah :=  $59;
  186.                  msdos(R);
  187.                  SimultOpen :=  R.AX;
  188.                  exit;
  189.                 end;
  190.                (*
  191.                INT 21,42 - Move File Pointer Using Handle
  192.  
  193.         AH =  42h
  194.         AL =  origin of move:
  195.              00 =  beginning of file plus offset  (SEEK_SET)
  196.              01 =  current location plus offset  (SEEK_CUR)
  197.              02 =  end of file plus offset  (SEEK_END)
  198.         BX =  file handle
  199.         CX =  high order word of number of bytes to move
  200.         DX =  low order word of number of bytes to move
  201.  
  202.         on return:
  203.         AX =  error code if CF set  (see DOS ERROR CODES)
  204.         DX:AX =  new pointer location if CF not set
  205.  
  206.         - seeks to specified location in file
  207.                    INT 21,  - Open File Using Handle
  208.         AH =
  209.         AL =  open access mode
  210.              00  read only
  211.              01  write only
  212.              02  read/write
  213.         DS:DX =  pointer to an ASCIIZ file name
  214.  =
  215.  
  216.         on return:
  217.         AX =  file handle if CF not set
  218.            =  error code if CF set  (see DOS ERROR CODES)
  219.         Access modes in AL:
  220.  
  221.         =B37=B36=B35=B34=B33=B32=B31=B30=B3  AL
  222.          =B3 =B3 =B3 =B3 =B3 =C0=C4=C1=C4=C1=C4=C4=C4=C4 read/write/updat=
  223. e access mode
  224.          =B3 =B3 =B3 =B3 =C0=C4=C4=C4=C4=C4=C4=C4=C4=C4 reserved, always =
  225. 0
  226.          =B3 =C0=C4=C1=C4=C1=C4=C4=C4=C4=C4=C4=C4=C4=C4=C4 sharing mode (=
  227. see below) (DOS 3.1+)
  228.          =C0=C4=C4=C4=C4=C4=C4=C4=C4=C4=C4=C4=C4=C4=C4=C4 1 =  private, =
  229. 0 =  inheritable (DOS 3.1+)
  230. =0D
  231.         Sharing mode bits (DOS 3.1+):          Access mode bits:
  232.         654                                    210
  233.         000  compatibility mode (exclusive)    000  read access
  234.         001  deny others read/write access     001  write access
  235.         010  deny others write access          010  read/write access
  236.         011  deny others read access
  237.         100  full access permitted to all
  238. *)
  239.                F.InOutFunc :=  @SimultWrite;
  240.                F.FlushFunc :=  @SimultWrite;
  241.                F.BufPos:= 0;
  242.                SimultOpen:= 0;
  243.               end;
  244.   else
  245.    SimultOpen :=  12; (* Invalid file access code - you can only Rewrite=
  246.  or Append this *)
  247.   end;
  248. end;
  249.  
  250. {$F+}function SimultClose(var F: textrec): integer; far;  {$F-}
  251. var
  252.   P: integer;
  253. begin;
  254.  if f.mode= fmclosed then
  255.   begin
  256.    SimultClose :=  103;
  257.    exit;
  258.   end;
  259. (*
  260.                   INT 21,3E - Close File Using Handle
  261.  
  262.         AH =  3E
  263.         BX =  file handle to close
  264.  
  265.         on return:
  266.         AX =  error code if CF set  (see DOS ERROR CODES)
  267.  
  268.         - if file is opened for update, file time and date stamp
  269.           as well as file size are updated in the directory
  270.         - handle is freed
  271. =0D
  272.  *)
  273.   r.ah :=  $3E;
  274.   r.bx :=  f.handle;
  275.   MsDos(R);
  276.   if (R.flags and fcarry)<>0 then
  277.    begin
  278.     r.ah :=  $59;
  279.     MsDos(R);
  280.     SimultClose :=  R.AX;
  281.     exit;
  282.    end;
  283.   F.Mode :=  FMClosed;
  284.   SimultClose:= 0;
  285. end;
  286.  
  287. {$F+} procedure AssignSimult(var f : text;n : string); {$F-}
  288. begin
  289.   with textrec(f) do begin
  290.     Mode     :=  fmClosed;
  291.     Handle   :=  $FFFF;
  292.     Bufsize  :=  SizeOf(Buffer);
  293.     Bufpos   :=  0;
  294.     Bufptr   :=  @Buffer;
  295.     OpenFunc :=  @SimultOpen;
  296.     CloseFunc:=  @SimultClose;
  297.     if n[0]>#79 then n[0] :=  #79; (* Truncate the name down to 79 chars=
  298.  *)
  299.     Move(N[1],Name[0],79);
  300.     Name[Length(N)] := #0; (* Name is null-terminated *)
  301.   end;
  302. end;
  303. begin
  304.  AssignCRT(OP);
  305.  Rewrite(OP);
  306. end.
  307.